home *** CD-ROM | disk | FTP | other *** search
/ SuperHack / SuperHack CD.bin / CODING / DELPHI / CODEAPP.ZIP / VIEWCODE.PAS < prev   
Encoding:
Pascal/Delphi Source File  |  1995-12-20  |  7.1 KB  |  285 lines
  1. unit Viewcode;
  2. (*-----
  3.     File: VIEWCODE.PAS for Project CODEAPP.DPR
  4. -----*)
  5.  
  6. interface
  7.  
  8. uses
  9.   SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,
  10.   Forms, Dialogs, StdCtrls, Buttons, ExtCtrls, Grids,
  11.   TextClip, FindWhat;
  12.  
  13. type
  14.   TViewText = class(TForm)
  15.     Panel1: TPanel;
  16.     CloseBtn: TBitBtn;
  17.     StringGrid1: TStringGrid;
  18.     Copy2TCBtn: TBitBtn;
  19.     Panel3: TPanel;
  20.     Label3: TLabel;
  21.     FindAgainBtn: TBitBtn;
  22.     FindWhatBtn: TBitBtn;
  23.     Label1: TLabel;
  24.     HelpBtn: TBitBtn;
  25.     RefNoteOption: TCheckBox;
  26.     procedure FormActivate(Sender: TObject);
  27.     procedure Copy2TCBtnClick(Sender: TObject);
  28.     procedure FormCreate(Sender: TObject);
  29.     procedure CloseBtnClick(Sender: TObject);
  30.     procedure FindAgainBtnClick(Sender: TObject);
  31.     procedure FindWhatBtnClick(Sender: TObject);
  32.     procedure StringGrid1TopLeftChanged(Sender: TObject);
  33.     procedure HelpBtnClick(Sender: TObject);
  34.     procedure StringGrid1KeyPress(Sender: TObject; var Key: Char);
  35.     procedure StringGrid1KeyDown(Sender: TObject; var Key: Word;
  36.       Shift: TShiftState);
  37.   private
  38.     { Private declarations }
  39.     FirstTime: boolean;
  40.     ViewFile: string;
  41.     Marker: string;
  42.     fsize: LongInt;
  43.     procedure FindString(const Atag: integer);
  44.     procedure DisplayPosition;
  45.   public
  46.     { Public declarations }
  47.     theTarget: string; {what to search for}
  48.     procedure LoadFile(const FN, FD: string);
  49.   end;
  50.  
  51. var
  52.   ViewText: TViewText;
  53.  
  54. implementation
  55.  
  56. {$R *.DFM}
  57.  
  58. procedure TViewText.FindString(const Atag: integer);
  59. {-Puts source containing 'target' into grid window view}
  60. const
  61.   { "Whole Word only" delimiters are any characters except these: }
  62.   WordDelimiters : set of Char = ['0'..'9', 'A'..'Z', 'a'..'z', '_'];
  63. var iy: integer;
  64.   Srect: TGridRect;
  65.   found: boolean;
  66.   cp, StartPoint: integer;
  67.   S: string;
  68. begin
  69.   Srect.Left := 0;
  70.   Srect.Right  := 0;
  71.   found := False;
  72.   with StringGrid1 do
  73.   begin
  74.     FirstTime := False;
  75.     if (ATag = 0) and FindWhatDlg.StartTop.Checked then
  76.       StartPoint := 0
  77.     else
  78.     begin
  79.       if TopRow < Row then
  80.         StartPoint := TopRow { start at top line in view}
  81.       else
  82.         StartPoint := TopRow+1; {just below top line in view}
  83.     end;
  84.     if FindWhatDlg.AnyCase.Checked then
  85.       theTarget := UpperCase(theTarget);
  86.     found := False;
  87.  
  88.     {Search loop}
  89.     for iy := StartPoint to RowCount do
  90.     begin
  91.       S := Cells[0, iy];
  92.       if FindWhatDlg.WholeWords.Checked then
  93.         S := ' '+S+' ';
  94.       if FindWhatDlg.AnyCase.Checked then
  95.         S := UpperCase(S);
  96.       cp := pos(theTarget, S);
  97.       if cp > 0 then
  98.       begin
  99.         if FindWhatDlg.WholeWords.Checked then
  100.           if (S[cp-1] in WordDelimiters) or
  101.              (S[cp+Length(theTarget)] in WordDelimiters) then
  102.             continue;
  103.         found := True;
  104.         break;
  105.       end;
  106.     end;
  107.  
  108.     if found then
  109.     begin
  110.       Srect.Top := iy;
  111.       Srect.Bottom  := iy;
  112.       Selection := Srect;
  113.       if iy >= RowCount - VisibleRowCount then
  114.         TopRow := RowCount - VisibleRowCount
  115.       else
  116.         TopRow := iy;
  117.     end
  118.     else
  119.       MessageBeep(64); {could put friendly msg box here instead}
  120.   end
  121. end;
  122.  
  123. procedure TViewText.FindAgainBtnClick(Sender: TObject);
  124. {-Find again action}
  125. begin
  126.   FindString(FindAgainBtn.Tag);
  127. end;
  128.  
  129. procedure TViewText.FindWhatBtnClick(Sender: TObject);
  130. {-Find string setup & go}
  131. begin
  132.   with FindWhatDlg do
  133.   begin
  134.     if ShowModal <> mrCancel then
  135.     begin
  136.       theTarget := ComboBox1.Text;
  137.       if theTarget <> ComboBox1.Items[0] then {stuff it once only}
  138.         ComboBox1.Items.Insert(0, theTarget);
  139.       FirstTime := True;
  140.       FindString(FindWhatBtn.Tag);
  141.     end;
  142.   end
  143. end;
  144.  
  145. procedure TViewText.LoadFile(const FN, FD: string);
  146. {-Load text into viewer}
  147. var
  148.   F: TextFile;
  149.   Buf: array[0..4095] of Char;
  150.   iy: integer;
  151.   S: string;
  152. begin
  153.   {Clear old - in case new file size=0 or load fail}
  154.   StringGrid1.RowCount := 12;
  155.   for iy := 0 to StringGrid1.RowCount do
  156.     StringGrid1.Cells[0, iy] := '';
  157.   {Load new}
  158.   ViewFile := FN;
  159.   AssignFile(F, FN);
  160.   Marker := Format('(* From: %s  %s, on %s *)',
  161.    [ExtractFileName(ViewFile), FD, DateTimeToStr(Now)]);
  162.   system.SetTextBuf(F, Buf);  { Bigger buffer for faster reads }
  163.   try
  164.     Reset(F);
  165.     try
  166.       iy := 0;
  167.       fsize := 0;
  168.       while not Eof(F) do
  169.       begin
  170.         readln(F, S);
  171.         inc(fsize, Length(S)+2);
  172.         StringGrid1.Cells[0, iy] := S;
  173.         inc(iy);
  174.         StringGrid1.RowCount := iy;
  175.       end;
  176.     finally
  177.       CloseFile(F);
  178.     end;
  179.     Caption := 'Viewer - '+ UpperCase(ExtractFileName(FN));
  180.  
  181.     with FindWhatDlg do
  182.     begin
  183.       if theTarget <> '' then
  184.       begin
  185.         ComboBox1.Text := theTarget;
  186.         if theTarget <> ComboBox1.Items[0] then {stuff it once only}
  187.           ComboBox1.Items.Insert(0, theTarget);
  188.         FirstTime := True;
  189.         FindString(FindWhatBtn.Tag);
  190.       end;
  191.     end;
  192.     Show;
  193.   except
  194.     MessageDlg('Unable to load '+FN, mtError, [mbOk], 0);
  195.   end;
  196. end;
  197.  
  198. procedure TViewText.DisplayPosition;
  199. begin
  200.   Label1.Caption := 'Top Line: '+IntTostr(StringGrid1.TopRow);
  201.   ActiveControl := StringGrid1;
  202. end;
  203.  
  204. procedure TViewText.FormActivate(Sender: TObject);
  205. {-Shows size of contents upon activation}
  206. begin
  207.   with StringGrid1 do
  208.   begin
  209.     Label3.Caption := Format('Lines: %d    Bytes: %s',
  210.       [RowCount, FormatFloat(',##########', fsize)]);
  211.     DisplayPosition;
  212.   end;
  213. end;
  214.  
  215. procedure TViewText.Copy2TCBtnClick(Sender: TObject);
  216. {-Copy StringGrid selection to Memo window}
  217. var iy: integer;
  218.   SRect: TGridRect;
  219. begin
  220.   SRect := StringGrid1.Selection;
  221.   with TextClips do
  222.   try
  223.     if RefNoteOption.Checked then
  224.     begin
  225.       Memo1.Lines.Add('');
  226.       Memo1.Lines.Add(Marker);
  227.     end;
  228.     for iy := Srect.Top to Srect.Bottom do
  229.       Memo1.Lines.Add(StringGrid1.Cells[0, iy]);
  230.     iy := Srect.Bottom-Srect.Top + 1;
  231.     inc(LinesCopied, iy);
  232.     Label1.Caption := Format('%d Lines added      %d Lines total',
  233.     [iy, LinesCopied]);
  234.     Show;
  235.     AllBtnClick(Sender);
  236.     CopyButtonClick(Sender);
  237.   except
  238.     MessageDlg('Error loading TextClip buffer.', mtError, [mbOk], 0);
  239.   end;
  240. end;
  241.  
  242. procedure TViewText.FormCreate(Sender: TObject);
  243. begin
  244.   Left := 0;
  245.   Top := (Screen.Height - Height) div 2; {center it}
  246.   FirstTime := False;
  247.   theTarget := '';
  248. end;
  249.  
  250. procedure TViewText.CloseBtnClick(Sender: TObject);
  251. begin
  252.   Close
  253. end;
  254.  
  255. procedure TViewText.StringGrid1TopLeftChanged(Sender: TObject);
  256. begin
  257.   DisplayPosition;
  258. end;
  259.  
  260. procedure TViewText.HelpBtnClick(Sender: TObject);
  261. {-Some help}
  262. begin
  263.   MessageDlg('Select lines of text and then,'+#13+
  264.   'click on Copy to TextClip.',
  265.   mtInformation, [mbCancel], 0);
  266.   ActiveControl := StringGrid1;
  267. end;
  268.  
  269. procedure TViewText.StringGrid1KeyPress(Sender: TObject; var Key: Char);
  270. begin
  271.   if Key = ^C then
  272.     Copy2TCBtnClick(Sender);
  273. end;
  274.  
  275. procedure TViewText.StringGrid1KeyDown(Sender: TObject; var Key: Word;
  276.   Shift: TShiftState);
  277. begin
  278.   if Key = VK_INSERT then
  279.     if ssCtrl in Shift then
  280.       Copy2TCBtnClick(Sender);
  281. end;
  282.  
  283. end.
  284.  
  285.